home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 4 / The 640 Meg Shareware Studio CD-ROM Volume IV (Data Express)(1994).ISO / clang / 120_01.zip / META4.MET < prev    next >
Text File  |  1993-06-01  |  6KB  |  202 lines
  1. .syn compile
  2. .field value 0 type 3 ;
  3. .constant name 1 field 3 constant 2 undefined 0
  4.          availfields 5
  5.          ;
  6. .name  number '0' id '0' savid '2' temp 'z'
  7.          stack 'y' unstack '!'
  8.          ;
  9. rvalue = 
  10.          idname &catname (':' idfield .cat ('m' id:value)
  11.                / .emp )
  12.          /constsimp
  13.                  .cat('n/' unstack ' ')
  14.          / '+' expression .cat('!')
  15.          ;
  16. expression = term $( '+' term .out('!+')
  17.              /'-' term .out('!-')
  18.              )
  19.         ;
  20. term = factor
  21.      $( '*' factor .out('!*')
  22.      / '/''256' .out('hz')
  23.             .out('!d')
  24.             .out('zy')
  25.      / '%256' 
  26.             .out('hy')
  27.             .out('n/''256*')
  28.             .out('!-')
  29.             )
  30.             ;
  31. factor = '(' expression ')' 
  32.           / constsimp .out('n/' unstack 'y' )
  33.           / idname &catname (':' idfield .cat('m' id:value)
  34.                               / .emp ) .out('y')
  35.           / '-' factor .out('!z')
  36.                        .out('n/''0y')
  37.                        .out('z-')
  38.           ;
  39.  
  40. catname = id:value =: stack 
  41.           .act('!l')        ! acts as a one byte macro
  42.           ;
  43.  
  44. toplace = idname id =: savid
  45.           (':' idfield .cat('i' id:value ) /.emp ) 
  46.           savid =: id &catname
  47.           ;
  48.  
  49. declare = '.field' $( idnew id =: savid
  50.                       constexp &checkfrange number =: savid:value
  51.                       field =: savid:type
  52.                     )   ';'
  53.                     / '.name' $( idnew id=:savid
  54.                       constexp unstack =: savid:value
  55.                       name =: savid:type
  56.                     )    ';'
  57.                     / '.constant' $( idnew id =: savid
  58.                       constexp constant =: savid:type 
  59.                       unstack =: savid:value
  60.                       )   ';'
  61.                     ;
  62.  
  63. constexp = constterm $( '+' constterm .act('!+')
  64.                       / '-' constterm .act('!-')
  65.                       );
  66.  
  67. constterm = constfac $( '*' constfac .act('!*')
  68.             );
  69.  
  70. constsimp = .num number =: stack
  71.             / idcons id:value =: stack
  72.             / .str "'" .act('n/0sy')  ! value is first character
  73.             / '.x' .hexnum ]number
  74.             ;
  75.  
  76. constfac = constsimp
  77.             / '-' constfac .act('!z' 'n/0y' 'z-')
  78.             / '(' constexp ')'
  79.             ;
  80.  
  81. idtype = .act ('li'                     ! is it an id ??
  82.                'f/'  *1                 ! no, return
  83.                'me'                     ! define or find
  84.                '0m3y' 'z='              ! id.type == temp
  85.                'l'  'r'                 ! take and return
  86.                '.'   *1                 ! noe accept or rewind input
  87.                'l'  'z9'    );
  88.  
  89. idname = .prep name =: temp idtype ;
  90.  
  91. idfield = .prep field =: temp idtype ;
  92.  
  93. idcons = .prep constant =: temp idtype ;
  94.  
  95. idnew = .prep undefined =: temp idtype ;
  96.  
  97. checkfrange = .if (number <= availfields)
  98.               .return
  99.               .else
  100.               .erms( number ' is too big for a field' )
  101.               .end
  102.              ;
  103.  
  104. aout = '*1' .out('u')
  105.      / '*2' .out('v')
  106.      / '*'  .out('c')
  107.      / (.str "'" /.str'"') .out('p' *)
  108.      / rvalue .out('c')
  109.      / '.h' rvalue .out('h')
  110.      / '.' .out('xn')
  111.      ;
  112.  
  113. notsyn = ( '.out' '(' $ aout ')'
  114.        / '.lab' .out('p... ') aout
  115.          )
  116.          .out('o')
  117.        / '.act' '(' $( (.str "'" / .str '"') .act('c')
  118.          ('*1' .act('u') / '*2' .act('v') / .emp)
  119.          .act('o')
  120.          / .str '!'
  121.          ) ')'
  122.        / ']' rvalue .out('y')
  123.        / rvalue '=:' toplace .out()
  124.        / '.if' '(' cexp ')' .out('f/' *1) $ notsyn
  125.          ('.else' .out('j/' *2) .lab*1 .out('s') $ notsyn '.end' .lab*2
  126.          / '.end'  .lab*1 .out('s')   )
  127.        / '.cat'  '(' $aout ')'
  128.        / '.condlab'
  129.                 ('*1' .out('uy')
  130.                       .out('0=')
  131.                       .out('t/' *1)
  132.                       .out('p... ')
  133.                       .out('u')
  134.                 /'*2' .out('vy')
  135.                       .out('0=')
  136.                       .out('t/' *1)
  137.                       .out('p... ')
  138.                       .out('v')
  139.                 )
  140.           .out('o')
  141.           .out('s')                ! ! ! note side effect ! ! !
  142.           .lab *1
  143.         / errormessage
  144.         / '.error'   .out('sf')
  145.         / '.succeed' .out('s')
  146.         / '.fail'    .out('sf')
  147.         / '&' idnew  .out('g' *)
  148.         / '.return'  .out('r')
  149.         / .str '!'
  150.         ;
  151.  
  152. cright = 
  153.          '=='  .out('y') rvalue .out('=')
  154.        / '!='  .out('y') rvalue .out('=') .out('sc')
  155.        / '<='  .out('y') rvalue .out('<') .out('sc')
  156.        / '>='  .out('y') rvalue .out('>') .out('sc')
  157.        / '<'   .out('y') rvalue .out('>')
  158.        / '>'   .out('y') rvalue .out('<')
  159.        ;
  160.  
  161. cterm = cfac $( '.andif' .out('f/' *2) cfac) .condlab *2 ;
  162.  
  163. cfac = rvalue cright
  164.      / '.not' cfac .out('sc')
  165.      / '(' cexp ')'
  166.      / '&' idnew .out('g' *) 
  167.      ;
  168.  
  169. cexp = cterm $( '.orif' .out('t/' *1) cterm) .condlab *1 ;
  170.  
  171. errormessage = '.erms' '(' .out('t/' *1) $aout ')' .out('xo') .lab *1 ;
  172.  
  173. syn = ( idnew .out('g' *)
  174.     / .str "'" .out('lm' *) .out('l')
  175.     / '.id' .out('li') .out('f/' *1) .out('l') .out('me') .lab *1
  176.     / '.num' .out('ln') .out('l')
  177.     / '.str' (.str "'" / .str '"') .out('lq' *) .out('l')
  178.     / '.emp' .out('s')
  179.     / '$' .lab *1 syn .out('t/' *1) .out('s')
  180.     / '(' phrase ')'
  181.     / '.hexnum' .out('lh') .out('l')
  182.     )
  183.     (errormessage / .emp)
  184.     ;
  185.  
  186. seq = syn .out('f/' *1)
  187.       $( syn .out('x') / notsyn )
  188.       .lab *1
  189.       ;
  190.  
  191. alts = seq $( '/' .out('t/' *1) seq ) .condlab *1 ;
  192.  
  193. phrase = '.prep' $notsyn alts / alts / notsyn $notsyn ;
  194.  
  195. statement = .id .lab * '=' phrase ';' .out('r') (.str '!' / .emp ) ;
  196.  
  197. compile = '.syn' .id .out('s') .out('xm') .out('g' *) .out('e') 
  198.           .act('xm;')    $ declare     $ statement
  199.           ;
  200.  
  201.  
  202.